PLS-SEM demo: Young people’s perceived service quality and environmental performance of hybrid electric bus.

R you ready? Intro to SEM in R.

Published

March 8, 2023

1 Sample study

2 Libraries

# Library
library(tidyverse)
library(readxl)
library(janitor)
library(seminr)
library(psych)
library(MVN)

3 Data

## data
case_data <- read_csv("data/e_bus_customer_satisfaction.csv") %>% 
 clean_names()

case_data_items <- case_data %>%
 select(bt1:bt7, bd1:bd4, emp1:emp5, cs1:cs3, ep1:ep4, ls1:ls5)

4 Exploratory factor analysis

4.1 Scree plot

## Scree plot using parallel analysis
fa.parallel(case_data_items, fa = "fa")

Parallel analysis suggests that the number of factors =  6  and the number of components =  NA 

4.2 Factor extraction

## Factor loading
bus_fa <- fa(r = case_data_items,
             nfactors = 6,
             rotate = "varimax")

print(bus_fa$loadings, sort = TRUE, cutoff = 0.4)

Loadings:
     MR2   MR1   MR3   MR4   MR6   MR5  
ls1  0.820                              
ls2  0.891                              
ls3  0.828                              
ls4  0.806                              
ls5  0.599                              
bt1        0.673                        
bt2        0.666                        
bt4        0.549                        
bt5        0.680                        
bt6        0.578                        
bt7        0.550                        
ep1              0.864                  
ep2              0.900                  
ep3              0.690                  
ep4              0.705                  
emp1                   0.688            
emp2                   0.662            
emp3                   0.636            
emp4                   0.697            
emp5                   0.502            
bd1                          0.679      
bd2                          0.640      
bd3                          0.676      
bd4                          0.629      
cs1                                0.774
cs2                                0.817
cs3                                0.768
bt3        0.476                        

                 MR2   MR1   MR3   MR4   MR6   MR5
SS loadings    3.477 3.363 3.081 2.658 2.429 2.297
Proportion Var 0.124 0.120 0.110 0.095 0.087 0.082
Cumulative Var 0.124 0.244 0.354 0.449 0.536 0.618

5 Partial-least square SEM

5.1 Specifying the measurement model

pls_mm_ebus <- 
  constructs(
  composite("tangible", multi_items("bt", c(1:2, 5:7))),
  composite("drivers_quality", multi_items("bd", 1:4)),
  composite("empathy", multi_items("emp", 1:5)),
  composite("env_perf", multi_items("ep", 1:4)),
  composite("customer_sat", multi_items("cs", 1:3)),
  composite("life_sat", multi_items("ls", 1:5))
)

plot(pls_mm_ebus)

5.2 Specifying the structural model

pls_sm_ebus <- 
  relationships(
  paths(from = c("tangible", "drivers_quality", "empathy", "env_perf"),
        to = "customer_sat"),
  paths(from = "customer_sat", to = "life_sat")
)

plot(pls_sm_ebus)

5.3 Estimating PLS-SEM model

pls_model_ebus <- 
  estimate_pls(
  data = case_data,
  measurement_model = pls_mm_ebus,
  structural_model = pls_sm_ebus
)


plot(pls_model_ebus)
summary_pls_model_ebus <- summary(pls_model_ebus)
summary_pls_model_ebus

Results from  package seminr (2.3.2)

Path Coefficients:
                customer_sat life_sat
R^2                    0.448    0.077
AdjR^2                 0.440    0.074
tangible               0.179        .
drivers_quality        0.146        .
empathy                0.310        .
env_perf               0.237        .
customer_sat               .    0.278

Reliability:
                alpha  rhoC   AVE  rhoA
tangible        0.830 0.880 0.595 0.831
drivers_quality 0.856 0.902 0.698 0.857
empathy         0.825 0.876 0.586 0.840
env_perf        0.920 0.944 0.808 0.926
customer_sat    0.941 0.962 0.895 0.944
life_sat        0.903 0.929 0.724 0.911

Alpha, rhoC, and rhoA should exceed 0.7 while AVE should exceed 0.5

5.4 Bootstraping PLS-SEM

## bootstrapping PLS-SEM model
boot_pls_model_ebus <- bootstrap_model(seminr_model = pls_model_ebus,
                nboot = 1000)

## summary results
summary_boot_pls_model_ebus <- summary(boot_pls_model_ebus, alpha = 0.10)
summary_boot_pls_model_ebus$bootstrapped_paths
                                  Original Est. Bootstrap Mean Bootstrap SD
tangible  ->  customer_sat                0.179          0.183        0.062
drivers_quality  ->  customer_sat         0.146          0.144        0.070
empathy  ->  customer_sat                 0.310          0.315        0.069
env_perf  ->  customer_sat                0.237          0.234        0.051
customer_sat  ->  life_sat                0.278          0.284        0.052
                                  T Stat. 5% CI 95% CI
tangible  ->  customer_sat          2.889 0.079  0.283
drivers_quality  ->  customer_sat   2.088 0.033  0.258
empathy  ->  customer_sat           4.475 0.197  0.425
env_perf  ->  customer_sat          4.663 0.148  0.313
customer_sat  ->  life_sat          5.307 0.196  0.371

5.5 Factor loadings

# DT::datatable(summary_boot_pls_model_ebus$bootstrapped_loadings %>% round(3))
summary_boot_pls_model_ebus$bootstrapped_loadings
                         Original Est. Bootstrap Mean Bootstrap SD T Stat.
bt1  ->  tangible                0.763          0.763        0.038  20.158
bt2  ->  tangible                0.766          0.765        0.035  21.631
bt5  ->  tangible                0.767          0.768        0.032  24.273
bt6  ->  tangible                0.790          0.789        0.029  26.769
bt7  ->  tangible                0.772          0.772        0.034  22.487
bd1  ->  drivers_quality         0.834          0.834        0.021  39.259
bd2  ->  drivers_quality         0.823          0.823        0.025  33.168
bd3  ->  drivers_quality         0.858          0.857        0.017  50.856
bd4  ->  drivers_quality         0.826          0.828        0.026  32.347
emp1  ->  empathy                0.768          0.769        0.029  26.199
emp2  ->  empathy                0.799          0.798        0.027  29.380
emp3  ->  empathy                0.699          0.695        0.044  16.001
emp4  ->  empathy                0.794          0.792        0.030  26.717
emp5  ->  empathy                0.762          0.764        0.027  27.791
ep1  ->  env_perf                0.905          0.903        0.018  49.194
ep2  ->  env_perf                0.947          0.946        0.010  98.438
ep3  ->  env_perf                0.875          0.875        0.021  40.860
ep4  ->  env_perf                0.866          0.866        0.028  30.676
cs1  ->  customer_sat            0.944          0.945        0.012  79.613
cs2  ->  customer_sat            0.960          0.960        0.007 147.488
cs3  ->  customer_sat            0.934          0.933        0.015  60.395
ls1  ->  life_sat                0.874          0.872        0.024  36.979
ls2  ->  life_sat                0.915          0.915        0.016  57.955
ls3  ->  life_sat                0.885          0.885        0.028  31.177
ls4  ->  life_sat                0.854          0.851        0.024  35.497
ls5  ->  life_sat                0.711          0.707        0.051  13.982
                         5% CI 95% CI
bt1  ->  tangible        0.699  0.822
bt2  ->  tangible        0.702  0.818
bt5  ->  tangible        0.715  0.817
bt6  ->  tangible        0.736  0.831
bt7  ->  tangible        0.713  0.823
bd1  ->  drivers_quality 0.797  0.866
bd2  ->  drivers_quality 0.780  0.862
bd3  ->  drivers_quality 0.829  0.883
bd4  ->  drivers_quality 0.783  0.868
emp1  ->  empathy        0.714  0.811
emp2  ->  empathy        0.751  0.837
emp3  ->  empathy        0.620  0.762
emp4  ->  empathy        0.741  0.836
emp5  ->  empathy        0.718  0.806
ep1  ->  env_perf        0.871  0.930
ep2  ->  env_perf        0.929  0.960
ep3  ->  env_perf        0.836  0.907
ep4  ->  env_perf        0.816  0.908
cs1  ->  customer_sat    0.924  0.962
cs2  ->  customer_sat    0.949  0.970
cs3  ->  customer_sat    0.907  0.955
ls1  ->  life_sat        0.827  0.906
ls2  ->  life_sat        0.887  0.938
ls3  ->  life_sat        0.831  0.924
ls4  ->  life_sat        0.810  0.886
ls5  ->  life_sat        0.614  0.776

5.6 Validity and reliability

# DT::datatable(summary_pls_model_ebus$reliability %>% round(3))
## Reliability measurment 
summary_pls_model_ebus$reliability
                alpha  rhoC   AVE  rhoA
tangible        0.830 0.880 0.595 0.831
drivers_quality 0.856 0.902 0.698 0.857
empathy         0.825 0.876 0.586 0.840
env_perf        0.920 0.944 0.808 0.926
customer_sat    0.941 0.962 0.895 0.944
life_sat        0.903 0.929 0.724 0.911

Alpha, rhoC, and rhoA should exceed 0.7 while AVE should exceed 0.5

5.7 Discriminant validity

## Fornell-Larcker criterion results
summary_pls_model_ebus$validity$fl_criteria
                tangible drivers_quality empathy env_perf customer_sat life_sat
tangible           0.772               .       .        .            .        .
drivers_quality    0.562           0.835       .        .            .        .
empathy            0.377           0.524   0.765        .            .        .
env_perf           0.471           0.421   0.380    0.899            .        .
customer_sat       0.489           0.509   0.544    0.500        0.946        .
life_sat           0.326           0.249   0.237    0.293        0.278    0.851

FL Criteria table reports square root of AVE on the diagonal and construct correlations on the lower triangle.

5.7.1 VIF

summary_pls_model_ebus$vif_antecedents
customer_sat :
       tangible drivers_quality         empathy        env_perf 
          1.624           1.783           1.445           1.392 

life_sat :
customer_sat 
           .